home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Pascal / Snippets / PWarp / Warp.p < prev   
Encoding:
Text File  |  1995-12-30  |  4.8 KB  |  219 lines  |  [TEXT/PJMM]

  1. program Pwarp;
  2.  
  3. {Based on Warp by Tony Mattis}
  4.  
  5. {Changes:}
  6. {• different colors on the stars}
  7. {• scaled sizes}
  8. {• works even without CQD}
  9.  
  10. {Changes nov-95:}
  11. {Universal interfaces}
  12. {PPC project}
  13.  
  14. {$IFC UNDEFINED THINK_PASCAL}
  15.         uses Types, QuickDraw, Events, Windows, Dialogs, Fonts, DiskInit,{}
  16.         TextEdit, Traps, Memory,{}
  17.         SegLoad, Scrap, ToolUtils, OSUtils, Menus, Resources, Packages; {}
  18. {$ENDC}
  19.  
  20.     const
  21.         kNumOfStars = 30;    {was 70}
  22.         kProjDistance = 150; {was 450}
  23.         kLargeStar = 0;
  24.         kSmallStar = 1;
  25.         kVelocity = 6;
  26.  
  27.     type
  28.         Star = record
  29.                 x, y, z: Longint;            {3D location}
  30.                 size: Integer;                {How big?}
  31.                 starColor: RGBColor;    {Draw in this color}
  32.                 location: Point;            {Screen location}
  33.             end;
  34.  
  35.     var
  36.         gStarField: array[0..kNumOfStars] of Star;
  37.         gOrigin: Point;
  38.         gWindow: WindowPtr;
  39.         gColorFlag: Boolean;
  40. gScreenRect:Rect;
  41.     procedure InitToolbox;
  42.         var
  43.             theWorld: SysEnvRec;
  44.     begin
  45. {$IFC UNDEFINED THINK_PASCAL}
  46.         InitGraf(@qd.thePort);
  47.         InitFonts;
  48.         InitWindows;
  49.         InitMenus;
  50.         TEInit;
  51.         InitDialogs(nil);
  52.         qd.randSeed := TickCount;
  53.         gScreenRect := qd.screenBits.bounds;
  54. {$ELSEC}
  55.         randSeed := TickCount;
  56.         gScreenRect := screenBits.bounds;
  57. {$ENDC}
  58.         InitCursor;
  59.  
  60.         if noErr = SysEnvirons(1, theWorld) then
  61.             gColorFlag := theWorld.hasColorQD;
  62.  
  63.         if gColorFlag then
  64.             gWindow := NewCWindow(nil, gScreenRect, '', true, plainDBox, WindowPtr(-1), false, 0)
  65.         else
  66.             gWindow := NewWindow(nil, gScreenRect, '', true, plainDBox, WindowPtr(-1), false, 0);
  67.  
  68. {Make the window cover the entire screen}
  69.         RectRgn(gWindow^.visRgn, gScreenRect);
  70.  
  71.         SetPort(gWindow);
  72.         PaintRect(gWindow^.portRect);
  73.     end;
  74.  
  75.     function GetRandom (min: Integer; max: Integer): Integer;
  76.     begin
  77.         GetRandom := abs(Random) mod (max - min + 1) + min;
  78.     end; {GetRandom}
  79.  
  80.     procedure CreateStar (var aStar: Star);
  81.     begin
  82.         aStar.x := GetRandom(0, gOrigin.h) - gOrigin.h div 2;
  83.         aStar.y := GetRandom(0, gOrigin.v) - gOrigin.v div 2;
  84.         aStar.z := GetRandom(0, 150) + 125;
  85.  
  86.         aStar.size := GetRandom(0, 1);
  87.  
  88.         if gColorFlag then
  89.             begin
  90.                 aStar.starColor.red := Random;
  91.                 aStar.starColor.green := Random;
  92.                 aStar.starColor.blue := Random;
  93.  
  94. {Set one component to max so all stars are bright}
  95.                 case GetRandom(1, 3) of
  96.                     1: 
  97.                         aStar.starColor.red := -1;
  98.                     2: 
  99.                         aStar.starColor.green := -1;
  100.                     3: 
  101.                         aStar.starColor.blue := -1;
  102.                 end; {case}
  103.             end;
  104.  
  105.     end; {CreateStar}
  106.  
  107.     procedure WarpColor (starColor: RGBColor);
  108.     begin
  109.         if gColorFlag then
  110.             RGBForeColor(starColor)
  111.         else
  112.             ForeColor(whiteColor);
  113.     end; {WarpColor}
  114.  
  115.     procedure InitStarField;
  116.         var
  117.             loop: Integer;
  118.     begin
  119.         gOrigin.h := (gScreenRect.right - gScreenRect.left) div 2;
  120.         gOrigin.v := (gScreenRect.bottom - gScreenRect.top) div 2;
  121.  
  122.         for loop := 0 to kNumOfStars - 1 do
  123.             CreateStar(gStarField[loop]);
  124.     end; {InitStarField}
  125.  
  126.     procedure DrawLargeStar (aStar: Star);
  127.         var
  128.             starRect: Rect;
  129.             starSize: Integer;
  130.         const
  131.             kStarScale = 300;
  132.             kViewBase = 5;
  133.     begin
  134.         starSize := 1 + kStarScale div (aStar.z + kViewBase);
  135.         starRect.left := aStar.location.h;
  136.         starRect.right := starRect.left + starSize;
  137.         starRect.top := aStar.location.v;
  138.         starRect.bottom := starRect.top + starSize;
  139.  
  140.         PaintOval(starRect);
  141.     end; {DrawLargeStar}
  142.  
  143.     procedure DrawSmallStar (aPt: Point);
  144.     begin
  145.         MoveTo(aPt.h, aPt.v);
  146.         LineTo(aPt.h, aPt.v);
  147.     end;
  148.  
  149. {Make a projection from 3D space to the screen}
  150.     function Project (aStar: Star): Point;
  151.         var
  152.             starRect: Point;
  153.     begin
  154.         starRect.h := aStar.x * kProjDistance div aStar.z + gOrigin.h;
  155.         starRect.v := aStar.y * kProjDistance div aStar.z + gOrigin.v;
  156.  
  157.         Project := starRect;
  158.     end; {Project}
  159.  
  160. {Move a star, reset it if necessary}
  161.     procedure AnimateStar (var aStar: Star);
  162.     begin
  163.         aStar.z := aStar.z - kVelocity;
  164.         if aStar.z <= 0 then
  165.             CreateStar(aStar);
  166.  
  167.         aStar.location := Project(aStar);
  168.  
  169.         if aStar.location.h < 0 then
  170.             CreateStar(aStar)
  171.         else if aStar.location.h > gScreenRect.right then
  172.             CreateStar(aStar)
  173.         else if aStar.location.v > gScreenRect.bottom then
  174.             CreateStar(aStar)
  175.         else if aStar.location.v < 0 then
  176.             CreateStar(aStar);
  177.     end; {AnimateStar}
  178.  
  179.     procedure AnimateStarField;
  180.         var
  181.             loop: Integer;
  182.     begin
  183.         for loop := 0 to kNumOfStars - 1 do
  184.             begin
  185.                 ForeColor(blackColor);
  186.                 if gStarField[loop].size = kLargeStar then
  187.                     DrawLargeStar(gStarField[loop])
  188.                 else
  189.                     DrawSmallStar(gStarField[loop].location);
  190.  
  191.                 AnimateStar(gStarField[loop]);
  192.                 WarpColor(gStarField[loop].starColor);
  193.  
  194.                 if gStarField[loop].size = kLargeStar then
  195.                     DrawLargeStar(gStarField[loop])
  196.                 else
  197.                     DrawSmallStar(gStarField[loop].location);
  198.             end;
  199.     end; {AnimateStarField}
  200.  
  201.     var
  202.         startTime: Longint;
  203.  
  204. begin {main program}
  205.     InitToolbox;
  206.     InitStarField;
  207.     HideCursor;
  208.  
  209.     while not Button do
  210.         begin
  211.             startTime := TickCount;
  212.             AnimateStarField;
  213.             while TickCount < startTime + 1 do
  214.                 ;
  215.         end;
  216.  
  217.     ShowCursor;
  218.  
  219. end. {main program}